perm filename BLOWUP.SAI[SYS,BGB] blob sn#101524 filedate 1974-05-09 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00010 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	BEGIN	"BLOWUP"
C00003 00003		PRELOAD_WITH 1,2,3,4,5,6
C00004 00004		ITG LDX,LDY,LDZ
C00006 00005	α WINDOW MOVING KEYS
C00008 00006	α WINDOW SIZE CONTROL KEYS
C00009 00007	PROCEDURE DIGIT
C00010 00008	PROCEDURE INSERIES
C00011 00009	α INPUT A 216 BY 288 TV IMAGE FROM THE DSK
C00012 00010	PROCEDURE XXXXXX
C00016 ENDMK
C⊗;
BEGIN	"BLOWUP"
	REQUIRE "ABBREV[SYS,BGB]" SOURCE_FILE;
	REQUIRE "DD" SOURCE_FILE;

α LEAPING LIZARDS;
	
	REQUIRE 100 NEW_ITEMS;
	REQUIRE 100 PNAMES;
	INTEGER ARRAY ITEMVAR TVFILE,SWINDO,OWINDO;

α TELETYPE COMMAND STATE;
	INTEGER CHR,CTRL,META,LETT,MCBITS;

α SOURCE AND OBJECT WINDOWS;
	DEFINE
	SX. = "DATUM(SWINDO)[1]",
	SY. = "DATUM(SWINDO)[2]",
	DX. = "DATUM(SWINDO)[3]",
	DY. = "DATUM(SWINDO)[4]",
	OX. = "DATUM(OWINDO)[1]",
	OY. = "DATUM(OWINDO)[2]",
	MP = "DATUM(OWINDO)[3]";
INTEGER FLG;
	PRELOAD_WITH 1,2,3,4,5,6;
	SAFE INTEGER ARRAY CHAN[1:7];

α NEW _DPYDD CALLS DDJOB;
	PROCEDURE _DPYDD; DPYDD(CVIS(TVFILE,FLG),∂(SWINDO),∂(OWINDO),CHAN);


α SET CHANNELS;
	PROCEDURE SETCHN;
BEGIN	"SETCHN"
	INTEGER I,ARG;
	ARG	←	INCHRW;
	IF ARG≤"0" ∨ "7"≤ARG THEN RETURN;
	ARG	←	ARG LAND 7;
	CHAN[1]	←	0;
	ARRBLT(CHAN[2],CHAN[1],5);
	IF CHR="←" THEN CHAN[ARG]←1 ELSE
	IF CHR="↑" THEN FOR I←1 STEP 1 UNTIL ARG DO CHAN[I]←I ELSE
	IF CHR="↓" THEN FOR I←1 STEP 1 UNTIL ARG DO CHAN[I]←I+1 ELSE
	RETURN;
	_DPYDD;
END	"SETCHN";
	ITG LDX,LDY,LDZ;
	REAL PDX,PDY,FOCAL,SCALX,SCALY,SCALZ;
	ITG DELTA;
	ITEMVAR LINK,NIL,LOCOR;
	SET TVSET;
PROCEDURE CARCAM;
BEGIN	"CARCAM"
	DEFINE MM="*3.2808@-3";
	LDX	←	144;
	LDY	←	108;
	LDZ	←	500;
	PDX	←	5.3 MM;
	PDY	←	4.0 MM;
	FOCAL	←	12.5 MM;
	SCALX	←	-FOCAL*LDX/PDX;
	SCALY	←	-FOCAL*LDY/PDY;
	SCALZ	←	 FOCAL*LDZ;
END	"CARCAM";

PROCEDURE INITIALIZATION;
BEGIN	"INIT"
	INTEGER ARRAY ∂S[1:5],∂O[1:7];
	SWINDO	←	NEW(∂S);	NEW_PNAME(SWINDO,"S0");
	OWINDO	←	NEW(∂O);	NEW_PNAME(OWINDO,"O0");
	SX.←SY.←0;
	OX.	←	0;
	OY.	←	0;
	DX.	←	144;
	DY.	←	108;
	MP	←	0;
	DELTA	←	1;
	LINK	←	NEW;
	NIL	←	NEW;
	LOCOR	←	NEW;
	CARCAM;
	OUTSTR("*");
END	"INIT";
α WINDOW MOVING KEYS;
PROCEDURE MOVKEY;
BEGIN	"MOVKEY"
	IF META THEN 
BEGIN
	IF CHR=";" ∧ OX.-DELTA≥0     THEN OX.←OX.-DELTA ELSE
	IF CHR=":" ∧ OX.+DELTA≤511   THEN OX.←OX.+DELTA ELSE
	IF CHR="(" ∧ OY.+DELTA*8<480 THEN OY.←OY.+DELTA*8 ELSE
	IF CHR=")" ∧ OY.-DELTA*8≥0   THEN OY.←OY.-DELTA*8 ;
END	ELSE
	IF CTRL THEN
BEGIN
	IF CHR=";" THEN SX.←SX.-DELTA ELSE
	IF CHR=":" THEN SX.←SX.+DELTA ELSE
	IF CHR="(" THEN SY.←SY.-DELTA ELSE
	IF CHR=")" THEN SY.←SY.+DELTA;
END	ELSE
BEGIN
	IF CHR=";" THEN SX.←SX.-DX. ELSE
	IF CHR=":" THEN SX.←SX.+DX. ELSE
	IF CHR="(" THEN SY.←SY.-DY. ELSE
	IF CHR=")" THEN SY.←SY.+DY.;
END;
	IF SX.+DX.> 144 THEN SX.← 144-DX. ELSE
	IF SX.-DX.<-144 THEN SX.←-144+DX.;
	IF SY.+DY.> 108 THEN SY.← 108-DY. ELSE
	IF SY.-DY.<-108 THEN SY.←-108+DY.;
	_DPYDD;
END	"MOVKEY";
α WINDOW SIZE CONTROL KEYS;
PROCEDURE DELKEY;
BEGIN	"DELKEY"
	IF CHR="[" ∧ DY.≠1   THEN DY.←DY.-1 ELSE
	IF CHR="]" ∧ DY.≠108 THEN DY.←DY.+1 ELSE
	IF CHR="↑" ∧ DX.≠1   THEN DX.←DX.-1 ELSE
	IF CHR="↓" ∧ DX.≠144 THEN DX.←DX.+1;
	IF SX.+DX.> 144 THEN SX.← 144-DX. ELSE
	IF SX.-DX.<-144 THEN SX.←-144+DX.;
	IF SY.+DY.> 108 THEN SY.← 108-DY. ELSE
	IF SY.-DY.<-108 THEN SY.←-108+DY.;
	_DPYDD;
END	"DELKEY";
PROCEDURE DIGIT;
BEGIN	"DIGIT"
	INTEGER DIG;
	DEFINE OXY(X,Y)="BEGIN OX.←X;OY.←Y;END";
	DIG	←	CHR LAND '17;
	IF META THEN
CASE DIG OF
BEGIN
	OXY(0,0);
	OXY(128,120);
	OXY(-128,120);
	OXY(-128,-120);
	OXY(128,-120);
	OY.←120;
	OY.←-120;
	OX.←-128;
	OX.←0;
	OX.←128;
END	ELSE
CASE DIG OF
BEGIN
	SX.←SY.←0;
	MP←0;
	;
	;
	DX.←DY.←4;
	DX.←DY.←9;
	DX.←DY.←18;
	DX.←DY.←36;
	BEGIN DX.←72;DY.←54;END;
	BEGIN DX.←144;DY.←108;SX.←SY.←0;END;
END;
	IF SX.+DX.> 144 THEN SX.← 144-DX. ELSE
	IF SX.-DX.<-144 THEN SX.←-144+DX.;
	IF SY.+DY.> 108 THEN SY.← 108-DY. ELSE
	IF SY.-DY.<-108 THEN SY.←-108+DY.;
END	"DIGIT";
PROCEDURE INSERIES;
BEGIN	"INSERIES"
	INTEGER L,M,FLG;
	STRING STR,S;
	OPEN(1,"TTY",0,1,0,0,0,0);
	OUTSTR("	SERIES = ");S←INCHWL;
	OUTSTR("	FIRST  = ");L←INTIN(1);
	OUTSTR("	LAST   = ");M←INTIN(1);
	RELEASE(1);
	IF L>M THEN L↔M;
DO BEGIN
	STR	←	S&CVS(L);
	TVFILE←CVSI(STR,FLG);
	IF FLG THEN 
	BEGIN 
		TVFILE←NEW(0);
		PUT TVFILE IN TVSET;
		NEW_PNAME(TVFILE,STR);
	END;
END	UNTIL M<(L←L+1);
	OUTCHR("*");
END	"INSERIES";

PROCEDURE DPYALL;
BEGIN
	ITG ITEMVAR TV;
	∀ TV|TVεTVSET DO
	 DPYDD(CVIS(TV,FLG),∂(SWINDO),∂(OWINDO),CHAN);
END;
α INPUT A 216 BY 288 TV IMAGE FROM THE DSK;
	STRING TVSTR;
PROCEDURE INDSK;
BEGIN	"INDSK"
	STRING STR;
	INTEGER FLG;
	OPEN(1,"DSK",8,3,0,0,0,0);
	OUTSTR(13&10);
DO BEGIN
	IF LENGTH(TVSTR)=0 THEN 
	BEGIN OUTSTR ("FILE = ");STR←INCHWL; END ELSE STR←TVSTR;

	IF STR<"A" ∨ "Z"<STR THEN BEGIN RELEASE(1);INSERIES;RETURN;END;

	LOOKUP(1,STR&".TMP[DAT,BGB]",FLG);TVSTR←"";
END	UNTIL ¬FLG;

	RELEASE(1);
	TVFILE←CVSI(STR,FLG);

	IF FLG THEN
	⊂ TVFILE←NEW(0);PUT TVFILE IN TVSET;NEW_PNAME(TVFILE,STR);⊃;

	OUTCHR("*");
END	"INDSK";
PROCEDURE XXXXXX;
BEGIN	"XXXXXX"
	WHILE TRUE DO 
BEGIN	"LISTEN"
	CHR	←	INCHRW;
	MCBITS	←	(CHR LSH -7)LAND 3;
	CTRL	←	CHR LAND '200;
	META	←	CHR LAND '400;
	CHR	←	CHR LAND '177;
	LETT	←	CHR LAND '37;

	IF CHR="A" THEN DPYALL ELSE
	IF CHR="D" THEN _DPYDD ELSE
	IF CHR="E" THEN ERASTV ELSE
	IF CHR="I" THEN INDSK  ELSE
	IF CHR="↓" THEN SETCHN ELSE
	IF CHR=13  THEN OUTSTR("*") ELSE
	IF CHR="(" THEN	MOVKEY ELSE
	IF CHR=")" THEN	MOVKEY ELSE
	IF CHR="*" THEN	MP←MP+1 ELSE
	IF CHR="-"∧MP≠0 THEN MP←MP-1 ELSE
	IF CHR="/"∧DELTA≠1 THEN DELTA←DELTA-1 ELSE
	IF "0"≤CHR ∧ CHR≤"9" THEN DIGIT ELSE
	IF CHR=":"∨CHR=";" THEN	MOVKEY ELSE
	IF CHR="["∨CHR="]" THEN DELKEY ELSE
	IF CHR="\" THEN DELTA←DELTA+1 ELSE
	IF CHR="↑"∨CHR="←" THEN	SETCHN;

END	"LISTEN";
END	"XXXXXX";

	INITIALIZATION;
	XXXXXX;
END	"BLOWUP"